home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 February: Tool Chest / Dev.CD Feb 95 / Dev.CD Feb 95.toast / Tool Chest / Development Tools & Languages / Dylan Related / Mindy-1.1 (sources only) / mindy-1.1 / comp / dump.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-08-18  |  25.6 KB  |  1,161 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: dump.c,v 1.18 94/07/26 18:36:15 hallgren Exp $
  27. *
  28. * This file dumps the results of the compilation into a .dbc file.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include <stdio.h>
  33. #ifdef ultrix
  34. #include <sys/types.h>
  35. #endif
  36. #include <sys/stat.h>
  37. #include <sys/time.h>
  38. #include <time.h>
  39. #include <limits.h>
  40. #include <string.h>
  41.  
  42. #ifdef sparc
  43. extern int gettimeofday(struct timeval *tp, struct timezone *tzp);
  44. #endif
  45.  
  46. #include "mindycomp.h"
  47. #include "src.h"
  48. #include "literal.h"
  49. #include "sym.h"
  50. #include "fileops.h"
  51. #include "compile.h"
  52. #include "dump.h"
  53. #include "version.h"
  54. #include "envanal.h"
  55. #include "lose.h"
  56.  
  57. static FILE *File = NULL;
  58. static int table_index = 0;
  59. static boolean ModuleDumped = FALSE;
  60.  
  61. static void dump_literal(struct literal *literal);
  62. static void dump_constant(struct constant *c);
  63. static void dump_constant(struct constant *c);
  64.  
  65.  
  66. /* Base output routines */
  67.  
  68. inline static void dump_byte(unsigned byte)
  69. {
  70.     putc(byte, File);
  71. }
  72.  
  73. #define dump_op dump_byte
  74.  
  75. inline static void dump_bytes(void *ptr, int bytes)
  76. {
  77.     int count;
  78.  
  79.     while (bytes > 0) {
  80.     count = fwrite(ptr, 1, bytes, File);
  81.     ptr += count;
  82.     bytes -= count;
  83.     }
  84. }
  85.  
  86. inline static void dump_short(short value)
  87. {
  88.     dump_bytes(&value, sizeof(value));
  89. }
  90.  
  91. inline static void dump_int(int value)
  92. {
  93.     dump_bytes(&value, sizeof(value));
  94. }
  95.  
  96. inline static void dump_long(long value)
  97. {
  98.     dump_bytes(&value, sizeof(value));
  99. }
  100.  
  101.  
  102. /* Table manipulation */
  103.  
  104. static int implicit_store(void)
  105. {
  106.     return table_index++;
  107. }
  108.  
  109. static int dump_store(void)
  110. {
  111.     dump_op(fop_STORE);
  112.     return table_index++;
  113. }
  114.  
  115. static void dump_ref(int handle)
  116. {
  117.     if (handle <= USHRT_MAX) {
  118.     dump_op(fop_SHORT_REF);
  119.     dump_short(handle);
  120.     }
  121.     else {
  122.     dump_op(fop_REF);
  123.     dump_int(handle);
  124.     }
  125. }
  126.  
  127.  
  128. /* Utility dumpers. */
  129.  
  130. static void dump_string_guts(int short_op, int long_op, char *str, int length)
  131. {
  132.     if (length < 256) {
  133.     dump_op(short_op);
  134.     dump_byte(length);
  135.     }
  136.     else {
  137.     dump_op(long_op);
  138.     dump_int(length);
  139.     }
  140.     dump_bytes(str, length);
  141. }
  142.  
  143. static void dump_integer(long value)
  144. {
  145.     if (SCHAR_MIN <= value && value <= SCHAR_MAX) {
  146.     dump_op(fop_SIGNED_BYTE);
  147.     dump_byte(value);
  148.     }
  149.     else if (SHRT_MIN <= value && value <= SHRT_MAX) {
  150.     dump_op(fop_SIGNED_SHORT);
  151.     dump_short(value);
  152.     }
  153.     else if (INT_MIN <= value && value <= INT_MAX) {
  154.     dump_op(fop_SIGNED_INT);
  155.     dump_int(value);
  156.     }
  157.     else {
  158.     dump_op(fop_SIGNED_LONG);
  159.     dump_long(value);
  160.     }
  161. }
  162.  
  163. static void dump_symbol(struct symbol *symbol)
  164. {
  165.     if (symbol->handle != -1)
  166.     dump_ref(symbol->handle);
  167.     else {
  168.     symbol->handle = implicit_store();
  169.     dump_string_guts(fop_SHORT_SYMBOL, fop_SYMBOL, symbol->name,
  170.              strlen(symbol->name));
  171.     }
  172. }
  173.  
  174.  
  175. /* Literal dumping. */
  176.  
  177. static void dump_symbol_literal(struct symbol_literal *literal)
  178. {
  179.     dump_symbol(literal->symbol);
  180. }
  181.  
  182. static void dump_integer_literal(struct integer_literal *literal)
  183. {
  184.     dump_integer(literal->value);
  185. }
  186.  
  187. static void dump_single_float_literal(struct single_float_literal *literal)
  188. {
  189.     dump_op(fop_SINGLE_FLOAT);
  190.     dump_bytes(&literal->value, sizeof(literal->value));
  191. }
  192.  
  193. static void dump_double_float_literal(struct double_float_literal *literal)
  194. {
  195.     dump_op(fop_DOUBLE_FLOAT);
  196.     dump_bytes(&literal->value, sizeof(literal->value));
  197. }
  198.  
  199. static void dump_extended_float_literal(struct extended_float_literal *literal)
  200. {
  201.     dump_op(fop_EXTENDED_FLOAT);
  202.     dump_bytes(&literal->value, sizeof(literal->value));
  203. }
  204.  
  205. static void dump_character_literal(struct character_literal *literal)
  206. {
  207.     dump_op(fop_CHAR);
  208.     dump_byte(literal->value);
  209. }
  210.  
  211. static void dump_string_literal(struct string_literal *literal)
  212. {
  213.     dump_string_guts(fop_SHORT_STRING, fop_STRING, literal->chars,
  214.              literal->length);
  215. }
  216.  
  217. static void dump_list_literal(struct list_literal *literal)
  218. {
  219.     struct literal *part;
  220.     int length;
  221.     int i;
  222.  
  223.     length = 0;
  224.     for (part = literal->first; part != NULL; part = part->next)
  225.     length++;
  226.  
  227.     part = literal->first;
  228.     while (length > 255+9) {
  229.     dump_op(fop_DOTTED_LISTN);
  230.     dump_byte(255);
  231.     for (i = 0; i < 255+9; i++) {
  232.         dump_literal(part);
  233.         part = part->next;
  234.     }
  235.     length -= 255+9;
  236.     }
  237.  
  238.     if (literal->tail)
  239.     switch (length) {
  240.       case 0: lose("Zero element dotted list?\n");
  241.       case 1: dump_op(fop_DOTTED_LIST1); break;
  242.       case 2: dump_op(fop_DOTTED_LIST2); break;
  243.       case 3: dump_op(fop_DOTTED_LIST3); break;
  244.       case 4: dump_op(fop_DOTTED_LIST4); break;
  245.       case 5: dump_op(fop_DOTTED_LIST5); break;
  246.       case 6: dump_op(fop_DOTTED_LIST6); break;
  247.       case 7: dump_op(fop_DOTTED_LIST7); break;
  248.       case 8: dump_op(fop_DOTTED_LIST8); break;
  249.       default:
  250.         dump_op(fop_DOTTED_LISTN);
  251.         dump_byte(length - 9);
  252.         break;
  253.     }
  254.     else
  255.     switch (length) {
  256.       case 0: dump_op(fop_NIL); break;
  257.       case 1: dump_op(fop_LIST1); break;
  258.       case 2: dump_op(fop_LIST2); break;
  259.       case 3: dump_op(fop_LIST3); break;
  260.       case 4: dump_op(fop_LIST4); break;
  261.       case 5: dump_op(fop_LIST5); break;
  262.       case 6: dump_op(fop_LIST6); break;
  263.       case 7: dump_op(fop_LIST7); break;
  264.       case 8: dump_op(fop_LIST8); break;
  265.       default:
  266.         dump_op(fop_LISTN);
  267.         dump_byte(length - 9);
  268.         break;
  269.     }
  270.     while (part != NULL) {
  271.     dump_literal(part);
  272.     part = part->next;
  273.     }
  274.     if (literal->tail)
  275.     dump_literal(literal->tail);
  276. }
  277.  
  278. static void dump_vector_header(int length)
  279. {
  280.     switch (length) {
  281.       case 0: dump_op(fop_VECTOR0); break;
  282.       case 1: dump_op(fop_VECTOR1); break;
  283.       case 2: dump_op(fop_VECTOR2); break;
  284.       case 3: dump_op(fop_VECTOR3); break;
  285.       case 4: dump_op(fop_VECTOR4); break;
  286.       case 5: dump_op(fop_VECTOR5); break;
  287.       case 6: dump_op(fop_VECTOR6); break;
  288.       case 7: dump_op(fop_VECTOR7); break;
  289.       case 8: dump_op(fop_VECTOR8); break;
  290.       default:
  291.     dump_op(fop_VECTORN);
  292.     if (length-9 < 254)
  293.         dump_byte(length-9);
  294.     else if (length-9-254 <= USHRT_MAX) {
  295.         dump_byte(254);
  296.         dump_short(length-9-254);
  297.     }
  298.     else {
  299.         dump_byte(255);
  300.         dump_int(length-9-254-USHRT_MAX-1);
  301.     }
  302.     break;
  303.     }
  304. }
  305.  
  306. static void dump_vector_literal(struct vector_literal *literal)
  307. {
  308.     struct literal *part;
  309.     int length;
  310.  
  311.     length = 0;
  312.     for (part = literal->first; part != NULL; part = part->next)
  313.     length++;
  314.  
  315.     dump_vector_header(length);
  316.  
  317.     for (part = literal->first; part != NULL; part = part->next)
  318.     dump_literal(part);
  319. }
  320.  
  321. static void dump_true_literal(struct literal *literal)
  322. {
  323.     dump_op(fop_TRUE);
  324. }
  325.  
  326. static void dump_false_literal(struct literal *literal)
  327. {
  328.     dump_op(fop_FALSE);
  329. }
  330.  
  331. static void dump_unbound_literal(struct literal *literal)
  332. {
  333.     dump_op(fop_UNBOUND);
  334. }
  335.  
  336. static void (*LiteralDumpers[(int)literal_Kinds])() = {
  337.     dump_symbol_literal, dump_integer_literal,
  338.     dump_single_float_literal, dump_double_float_literal,
  339.     dump_extended_float_literal, dump_character_literal, dump_string_literal,
  340.     dump_list_literal, dump_vector_literal, dump_true_literal,
  341.     dump_false_literal, dump_unbound_literal
  342. };
  343.  
  344. static void dump_literal(struct literal *literal)
  345. {
  346.     (LiteralDumpers[(int)literal->kind])(literal);
  347. }
  348.  
  349.  
  350.  
  351. /* Debug info dumping. */
  352.  
  353. static void dump_vars(struct scope_info *scope)
  354. {
  355.     struct var_info *var_info;
  356.  
  357.     if (scope->handle != -1)
  358.     dump_ref(scope->handle);
  359.     else {
  360.     scope->handle = dump_store();
  361.  
  362.     if (scope->outer)
  363.         dump_op(fop_DOTTED_LIST1);
  364.     else
  365.         dump_op(fop_LIST1);
  366.  
  367.     dump_vector_header(scope->nvars);
  368.     for (var_info=scope->vars; var_info != NULL; var_info=var_info->next) {
  369.         int loc_info = var_info->offset << 2;
  370.         if (var_info->indirect)
  371.         loc_info |= 2;
  372.         if (var_info->argument)
  373.         loc_info |= 1;
  374.  
  375.         dump_op(fop_VECTOR2);
  376.         dump_symbol(var_info->var->symbol);
  377.         dump_integer(loc_info);
  378.     }
  379.  
  380.     if (scope->outer)
  381.         dump_vars(scope->outer);
  382.     }
  383. }
  384.  
  385. static void dump_debug_info(struct component *c)
  386. {
  387.     struct debug_info *info;
  388.     
  389.     dump_vector_header(c->ndebug_infos);
  390.     for (info = c->debug_info; info != NULL; info = info->next) {
  391.     dump_op(fop_VECTOR3);
  392.     dump_integer(info->line);
  393.     dump_integer(info->bytes);
  394.     if (info->scope)
  395.         dump_vars(info->scope);
  396.     else
  397.         dump_op(fop_NIL);
  398.     }
  399. }
  400.  
  401.  
  402. /* Method Dumping */
  403.  
  404. static void dump_component(struct component *c)
  405. {
  406.     struct constant *constant;
  407.     struct block *block;
  408.     int bytes;
  409.  
  410.     if (c->nconstants < 256 && c->bytes < (1<<16)) {
  411.     dump_op(fop_SHORT_COMPONENT);
  412.     dump_byte(c->nconstants);
  413.     dump_short(c->bytes);
  414.     }
  415.     else {
  416.     dump_op(fop_COMPONENT);
  417.     dump_int(c->nconstants);
  418.     dump_int(c->bytes);
  419.     }
  420.  
  421.     if (c->debug_name)
  422.     dump_literal(c->debug_name);
  423.     else
  424.     dump_op(fop_FALSE);
  425.  
  426.     dump_integer(c->frame_size);
  427.  
  428.     dump_debug_info(c);
  429.  
  430.     for (constant = c->constants; constant != NULL; constant = constant->next)
  431.     dump_constant(constant);
  432.  
  433.     bytes = 0;
  434.     for (block = c->blocks; block != NULL; block = block->next) {
  435.     int count = block->end - block->bytes;
  436.     dump_bytes(block->bytes, count);
  437.     bytes += count;
  438.     }
  439.     if (bytes != c->bytes)
  440.     lose("Planned on writing %d bytes, but ended up writing %d instead.",
  441.          c->bytes, bytes);
  442. }
  443.  
  444. static void dump_method(struct method *method)
  445. {
  446.     struct param_list *params = method->params;
  447.     struct keyword_param *k;
  448.     int param_info, nkeys;
  449.     int nclosure_vars;
  450.     struct closes_over *over;
  451.  
  452.     if (params->rest_param)
  453.     param_info = 1;
  454.     else
  455.     param_info = 0;
  456.     if (params->all_keys)
  457.     param_info |= 2;
  458.     if (params->allow_keys) {
  459.     nkeys = 0;
  460.     for (k = params->keyword_params; k != NULL; k = k->next)
  461.         nkeys++;
  462.     param_info = param_info | (nkeys+1)<<2;
  463.     }
  464.     
  465.     nclosure_vars = 0;
  466.     for (over = method->closes_over; over != NULL; over = over->next)
  467.     nclosure_vars++;
  468.     
  469.     if (param_info < 256 && nclosure_vars < 256) {
  470.     dump_op(fop_SHORT_METHOD);
  471.     dump_byte(param_info);
  472.     dump_byte(nclosure_vars);
  473.     }
  474.     else {
  475.     dump_op(fop_METHOD);
  476.     dump_int(param_info);
  477.     dump_int(nclosure_vars);
  478.     }
  479.  
  480.     for (k = params->keyword_params; k != NULL; k = k->next) {
  481.     struct literal_expr *def = (struct literal_expr *)k->def;
  482.     dump_symbol(k->keyword);
  483.     if (def) {
  484.         if (def->kind != expr_LITERAL)
  485.         lose("non-literal keyword default made it though expand?");
  486.         dump_literal(def->lit);
  487.     }
  488.     else
  489.         dump_op(fop_FALSE);
  490.     }
  491.  
  492.     dump_component(method->component);
  493. }
  494.  
  495. static void dump_varref(struct id *id, boolean written)
  496. {
  497.     if (id->internal)
  498.     if (written)
  499.         dump_op(fop_BUILTIN_WRITABLE_VALUE_CELL);
  500.     else
  501.         dump_op(fop_BUILTIN_VALUE_CELL);
  502.     else
  503.     if (written)
  504.         dump_op(fop_WRITABLE_VALUE_CELL);
  505.     else
  506.         dump_op(fop_VALUE_CELL);
  507.  
  508.     dump_symbol(id->symbol);
  509. }
  510.  
  511. static void dump_constant(struct constant *c)
  512. {
  513.     switch (c->kind) {
  514.       case constant_LITERAL:
  515.     dump_literal(c->u.literal);
  516.     break;
  517.       case constant_METHODDESC:
  518.     dump_method(c->u.method);
  519.     break;
  520.       case constant_VARREF:
  521.     dump_varref(c->u.varref.id, c->u.varref.written);
  522.     break;
  523.     }
  524. }
  525.  
  526.  
  527. /* Defconst and Defvar dumping. */
  528.  
  529. static void dump_defconst_or_var(struct param_list *params)
  530. {
  531.     int count;
  532.     struct param *p;
  533.  
  534.     count = 0;
  535.     for (p = params->required_params; p != NULL; p = p->next)
  536.     count++;
  537.     if (params->rest_param)
  538.     count++;
  539.  
  540.     dump_integer(count);
  541.     for (p = params->required_params; p != NULL; p = p->next)
  542.     dump_symbol(p->id->symbol);
  543.     if (params->rest_param)
  544.     dump_symbol(params->rest_param->symbol);
  545. }
  546.  
  547.  
  548. /* Namespace (module and library) dumping. */
  549.  
  550.  
  551. static void dump_defnamespace(struct defnamespace_constituent *c,
  552.                   boolean dump_creates)
  553. {
  554.     struct use_clause *use;
  555.  
  556.     dump_literal(c->name);
  557.     for (use = c->use_clauses; use != NULL; use = use->next) {
  558.     dump_literal(use->name);
  559.     dump_literal(use->import);
  560.     dump_literal(use->exclude);
  561.     dump_literal(use->prefix);
  562.     dump_literal(use->rename);
  563.     dump_literal(use->export);
  564.     }
  565.     dump_op(fop_FALSE);
  566.     dump_literal(c->exported_literal);
  567.     if (dump_creates)
  568.     dump_literal(c->created_literal);
  569. }
  570.  
  571.  
  572. /* Interface to the output file dumper */
  573.  
  574. void dump_setup_output(char *source, FILE *file)
  575. {
  576.     struct stat buf;
  577.     struct timeval tv;
  578.     int statres;
  579.  
  580.     File = file;
  581.  
  582.     fprintf(File, "# %s (%d.%d) of %s\n", ParseOnly ? "parse" : "compilation",
  583.         file_MajorVersion, file_MinorVersion, source);
  584.     statres = stat(source, &buf);
  585.     if (statres >= 0)
  586.     fprintf(File, "# last modified on %s", ctime(&buf.st_mtime));
  587.     fprintf(File, "# produced with the %s version of mindycomp\n", Version);
  588.     gettimeofday(&tv, NULL);
  589.     fprintf(File, "# at %s", ctime(&tv.tv_sec));
  590.  
  591.     dump_op(fop_HEADER);
  592.     dump_byte(file_MajorVersion);
  593.     dump_byte(file_MinorVersion);
  594.     dump_byte(sizeof(short));
  595.     dump_byte(sizeof(int));
  596.     dump_byte(sizeof(long));
  597.     dump_byte(sizeof(float));
  598.     dump_byte(sizeof(double));
  599.     dump_byte(sizeof(long double));
  600.     dump_short(1);
  601.     if (ParseOnly)
  602.     dump_int(parse_MagicNumber);
  603.     else
  604.     dump_int(dbc_MagicNumber);
  605.     dump_op(fop_IN_LIBRARY);
  606.     if (LibraryName)
  607.     dump_symbol(LibraryName);
  608.     else
  609.     dump_symbol(sym_DylanUser);
  610.     if (ParseOnly) {
  611.     dump_op(fop_IN_MODULE);
  612.     dump_symbol(ModuleName);
  613.     ModuleDumped = TRUE;
  614.     }
  615.     if (source != NULL) {
  616.     dump_op(fop_SOURCE_FILE);
  617.     if (statres >= 0)
  618.         dump_integer(buf.st_mtime);
  619.     else
  620.         dump_integer(0);
  621.     dump_string_guts(fop_SHORT_STRING, fop_STRING, source, strlen(source));
  622.     }
  623. }
  624.  
  625. void dump_top_level_form(struct component *c)
  626. {
  627.     if (!ModuleDumped) {
  628.     dump_op(fop_IN_MODULE);
  629.     dump_symbol(ModuleName);
  630.     ModuleDumped = TRUE;
  631.     }
  632.  
  633.     dump_op(fop_TOP_LEVEL_FORM);
  634.     dump_component(c);
  635. }
  636.  
  637. void dump_defmethod(struct id *name, struct component *c)
  638. {
  639.     if (!ModuleDumped) {
  640.     dump_op(fop_IN_MODULE);
  641.     dump_symbol(ModuleName);
  642.     ModuleDumped = TRUE;
  643.     }
  644.  
  645.     dump_op(fop_DEFINE_METHOD);
  646.     dump_symbol(name->symbol);
  647.     dump_component(c);
  648. }
  649.  
  650. void dump_defgeneric(struct id *name, struct component *tlf)
  651. {
  652.     if (!ModuleDumped) {
  653.     dump_op(fop_IN_MODULE);
  654.     dump_symbol(ModuleName);
  655.     ModuleDumped = TRUE;
  656.     }
  657.  
  658.     dump_op(fop_DEFINE_GENERIC);
  659.     dump_symbol(name->symbol);
  660.     dump_component(tlf);
  661. }
  662.  
  663. void dump_defclass(struct id *name, struct slot_spec *slots,
  664.            struct component *tlf1, struct component *tlf2)
  665. {
  666.     struct slot_spec *slot;
  667.  
  668.     if (!ModuleDumped) {
  669.     dump_op(fop_IN_MODULE);
  670.     dump_symbol(ModuleName);
  671.     ModuleDumped = TRUE;
  672.     }
  673.  
  674.     dump_op(fop_DEFINE_CLASS);
  675.     dump_symbol(name->symbol);
  676.     for (slot = slots; slot != NULL; slot = slot->next) {
  677.     dump_symbol(slot->getter->symbol);
  678.     if (slot->setter)
  679.         dump_symbol(slot->setter->symbol);
  680.     }
  681.     dump_op(fop_FALSE);
  682.     dump_component(tlf1);
  683.     dump_component(tlf2);
  684. }
  685.  
  686. void dump_defconst(struct param_list *params, struct component *initializer)
  687. {
  688.     if (!ModuleDumped) {
  689.     dump_op(fop_IN_MODULE);
  690.     dump_symbol(ModuleName);
  691.     ModuleDumped = TRUE;
  692.     }
  693.  
  694.     dump_op(fop_DEFINE_CONSTANT);
  695.     dump_defconst_or_var(params);
  696.     dump_component(initializer);
  697. }
  698.  
  699. void dump_defvar(struct param_list *params, struct component *initializer)
  700. {
  701.     if (!ModuleDumped) {
  702.     dump_op(fop_IN_MODULE);
  703.     dump_symbol(ModuleName);
  704.     ModuleDumped = TRUE;
  705.     }
  706.  
  707.     dump_op(fop_DEFINE_VARIABLE);
  708.     dump_defconst_or_var(params);
  709.     dump_component(initializer);
  710. }
  711.  
  712. void dump_defmodule(struct defnamespace_constituent *c)
  713. {
  714.     dump_op(fop_DEFINE_MODULE);
  715.     dump_defnamespace(c, TRUE);
  716. }
  717.  
  718. void dump_deflibrary(struct defnamespace_constituent *c)
  719. {
  720.     dump_op(fop_DEFINE_LIBRARY);
  721.     dump_defnamespace(c, FALSE);
  722. }
  723.  
  724. void dump_finalize_output(void)
  725. {
  726.     dump_op(fop_DONE);
  727. }
  728.  
  729.  
  730.  
  731. /* Stuff to dump program parses */
  732.  
  733. static void dump_body(struct body *body);
  734. static void dump_expr(struct expr *expr);
  735.  
  736. static void dump_id(struct id *id)
  737. {
  738.     dump_symbol(id->symbol);
  739.     dump_op(id->internal ? fop_TRUE : fop_FALSE);
  740.     dump_integer(id->line);
  741. }
  742.  
  743. static void dump_param_list(struct param_list *params)
  744. {
  745.     struct param *p;
  746.     int nparams = 0;
  747.  
  748.     for (p = params->required_params; p != NULL; p = p->next)
  749.     nparams++;
  750.     dump_integer(nparams);
  751.     for (p = params->required_params; p != NULL; p = p->next) {
  752.     dump_id(p->id);
  753.     if (p->type)
  754.         dump_expr(p->type);
  755.     else
  756.         dump_op(fop_FALSE);
  757.     }
  758.  
  759.     if (params->next_param)
  760.     dump_id(params->next_param);
  761.     else
  762.     dump_op(fop_FALSE);
  763.  
  764.     if (params->rest_param)
  765.     dump_id(params->rest_param);
  766.     else
  767.     dump_op(fop_FALSE);
  768.  
  769.     if (params->allow_keys) {
  770.     struct keyword_param *k;
  771.     int nkeys = 0;
  772.  
  773.     for (k = params->keyword_params; k != NULL; k = k->next)
  774.         nkeys++;
  775.     dump_integer(nkeys);
  776.  
  777.     for (k = params->keyword_params; k != NULL; k = k->next) {
  778.         dump_symbol(k->keyword);
  779.         dump_id(k->id);
  780.         if (k->type)
  781.         dump_expr(k->type);
  782.         else
  783.         dump_op(fop_FALSE);
  784.         if (k->def)
  785.         dump_expr(k->def);
  786.         else
  787.         dump_op(fop_FALSE);
  788.     }
  789.     }
  790.     else
  791.     dump_op(fop_FALSE);
  792. }
  793.  
  794. static void dump_bindings(struct bindings *bindings)
  795. {
  796.     dump_param_list(bindings->params);
  797.     dump_expr(bindings->expr);
  798. }
  799.  
  800. static void dump_rettypes(struct return_type_list *rettypes)
  801. {
  802.     struct return_type *r;
  803.     int nreq = 0;
  804.  
  805.     if (rettypes != NULL) {
  806.     for (r = rettypes->req_types; r != NULL; r = r->next)
  807.         nreq++;
  808.     dump_integer(nreq);
  809.     for (r = rettypes->req_types; r != NULL; r = r->next)
  810.         if (r->type)
  811.         dump_expr(r->type);
  812.         else
  813.         dump_op(fop_FALSE);
  814.     if (rettypes->rest_type)
  815.         dump_expr(r->type);
  816.     else
  817.         dump_op(fop_FALSE);
  818.     }
  819.     else
  820.     dump_op(fop_FALSE);
  821. }
  822.  
  823. static void dump_plist(struct plist *plist)
  824. {
  825.     if (plist) {
  826.     struct property *p;
  827.     int nprops = 0;
  828.  
  829.     for (p = plist->head; p != NULL; p = p->next)
  830.         nprops++;
  831.     dump_integer(nprops);
  832.     for (p = plist->head; p != NULL; p = p->next) {
  833.         dump_symbol(p->keyword);
  834.         dump_expr(p->expr);
  835.     }
  836.     }
  837.     else
  838.     dump_integer(0);
  839. }
  840.  
  841. static void dump_method_parse(struct method *method)
  842. {
  843.     if (method->name)
  844.     dump_id(method->name);
  845.     else
  846.     dump_op(fop_FALSE);
  847.     dump_param_list(method->params);
  848.     dump_rettypes(method->rettypes);
  849.     dump_body(method->body);
  850. }
  851.  
  852. static void dump_varref_expr(struct varref_expr *expr)
  853. {
  854.     dump_op(fop_VARREF_EXPR);
  855.     dump_id(expr->var);
  856. }
  857.  
  858. static void dump_literal_expr(struct literal_expr *expr)
  859. {
  860.     dump_op(fop_LITERAL_EXPR);
  861.     dump_literal(expr->lit);
  862. }
  863.  
  864. static void dump_call_expr(struct call_expr *expr)
  865. {
  866.     struct argument *args;
  867.     int nargs = 0;
  868.  
  869.     dump_op(fop_CALL_EXPR);
  870.     dump_expr(expr->func);
  871.     for (args = expr->args; args != NULL; args = args->next)
  872.     nargs++;
  873.     dump_integer(nargs);
  874.     for (args = expr->args; args != NULL; args = args->next)
  875.     dump_expr(args->expr);
  876. }
  877.  
  878. static void dump_method_expr(struct method_expr *expr)
  879. {
  880.     dump_op(fop_METHOD_EXPR);
  881.     dump_method_parse(expr->method);
  882. }
  883.  
  884. static void dump_dot_expr(struct dot_expr *expr)
  885. {
  886.     dump_op(fop_DOT_EXPR);
  887.     dump_expr(expr->arg);
  888.     dump_expr(expr->func);
  889. }
  890.  
  891. static void dump_body_expr(struct body_expr *expr)
  892. {
  893.     dump_op(fop_BODY_EXPR);
  894.     dump_body(expr->body);
  895. }
  896.  
  897. static void dump_block_expr(struct block_expr *expr)
  898. {
  899.     dump_op(fop_BLOCK_EXPR);
  900.     if (expr->exit_fun)
  901.     dump_id(expr->exit_fun);
  902.     else
  903.     dump_op(fop_FALSE);
  904.     dump_body(expr->body);
  905.     if (expr->inner)
  906.     lose("Dumping a block that still has exception clauses?");
  907.     if (expr->cleanup)
  908.     dump_body(expr->cleanup);
  909.     else
  910.     dump_op(fop_FALSE);
  911.     if (expr->outer)
  912.     lose("Dumping a block that still has exception clauses?");
  913. }
  914.  
  915. static void dump_case_expr(struct case_expr *expr)
  916. {
  917.     lose("case made it though expand?");
  918. }
  919.  
  920. static void dump_if_expr(struct if_expr *expr)
  921. {
  922.     dump_op(fop_IF_EXPR);
  923.     dump_expr(expr->cond);
  924.     dump_body(expr->consequent);
  925.     dump_body(expr->alternate);
  926. }
  927.  
  928. static void dump_for_expr(struct for_expr *expr)
  929. {
  930.     lose("for made it though expand?");
  931. }
  932.  
  933. static void dump_select_expr(struct select_expr *expr)
  934. {
  935.     lose("select made it though expand?");
  936. }
  937.  
  938. static void dump_varset_expr(struct varset_expr *expr)
  939. {
  940.     dump_op(fop_VARSET_EXPR);
  941.     dump_id(expr->var);
  942.     dump_expr(expr->value);
  943. }
  944.  
  945. static void dump_binop_series_expr(struct binop_series_expr *expr)
  946. {
  947.     lose("binop series made it though expand?");
  948. }
  949.  
  950. static void dump_loop_expr(struct loop_expr *expr)
  951. {
  952.     dump_op(fop_LOOP_EXPR);
  953.     dump_body(expr->body);
  954. }
  955.  
  956. static void dump_repeat_expr(struct repeat_expr *expr)
  957. {
  958.     dump_op(fop_REPEAT_EXPR);
  959. }
  960.  
  961. static void dump_error_expr(struct expr *expr)
  962. {
  963.     lose("Called dump on a parse tree with errors?");
  964. }
  965.  
  966. static void (*ExpressionDumpers[])() = {
  967.     dump_varref_expr, dump_literal_expr, dump_call_expr,
  968.     dump_method_expr, dump_dot_expr, dump_body_expr, dump_block_expr,
  969.     dump_case_expr, dump_if_expr, dump_for_expr, dump_select_expr,
  970.     dump_varset_expr, dump_binop_series_expr, dump_loop_expr,
  971.     dump_repeat_expr, dump_error_expr
  972. };
  973.  
  974. static void dump_expr(struct expr *expr)
  975. {
  976.     (*ExpressionDumpers[(int)expr->kind])(expr);
  977. }
  978.  
  979. static void dump_defconst_constituent(struct defconst_constituent *c)
  980. {
  981.     dump_op(fop_DEFINE_CONSTANT);
  982.     dump_bindings(c->bindings);
  983. }
  984.  
  985. static void dump_defvar_constituent(struct defvar_constituent *c)
  986. {
  987.     dump_op(fop_DEFINE_VARIABLE);
  988.     dump_bindings(c->bindings);
  989. }
  990.  
  991. static void dump_defmethod_constituent(struct defmethod_constituent *c)
  992. {
  993.     dump_op(fop_DEFINE_METHOD);
  994.     dump_method_parse(c->method);
  995. }
  996.  
  997. static void dump_defgeneric_constituent(struct defgeneric_constituent *c)
  998. {
  999.     dump_op(fop_DEFINE_GENERIC);
  1000.     dump_id(c->name);
  1001.     dump_param_list(c->params);
  1002.     dump_rettypes(c->rettypes);
  1003.     dump_plist(c->plist);
  1004. }
  1005.  
  1006. static void dump_defclass_constituent(struct defclass_constituent *c)
  1007. {
  1008.     struct superclass *super;
  1009.     struct slot_spec *slot;
  1010.     struct initarg_spec *initarg;
  1011.     struct inherited_spec *inherited;
  1012.     int n;
  1013.  
  1014.     dump_op(fop_DEFINE_CLASS);
  1015.  
  1016.     n = 0;
  1017.     for (super = c->supers; super != NULL; super = super->next)
  1018.     n++;
  1019.     dump_integer(n);
  1020.     for (super = c->supers; super != NULL; super = super->next)
  1021.     dump_expr(super->expr);
  1022.     
  1023.     n = 0;
  1024.     for (slot = c->slots; slot != NULL; slot = slot->next)
  1025.     n++;
  1026.     dump_integer(n);
  1027.     for (slot = c->slots; slot != NULL; slot = slot->next) {
  1028.     switch (slot->alloc) {
  1029.       case alloc_INSTANCE:
  1030.         dump_symbol(sym_Instance);
  1031.         break;
  1032.       case alloc_CLASS:
  1033.         dump_symbol(sym_Class);
  1034.         break;
  1035.       case alloc_SUBCLASS:
  1036.         dump_symbol(sym_Subclass);
  1037.         break;
  1038.       case alloc_CONSTANT:
  1039.         dump_symbol(sym_Constant);
  1040.         break;
  1041.       case alloc_VIRTUAL:
  1042.         dump_symbol(sym_Virtual);
  1043.         break;
  1044.       default:
  1045.         lose("strange slot allocation");
  1046.     }
  1047.     if (slot->name)
  1048.         dump_id(slot->name);
  1049.     else
  1050.         dump_op(fop_FALSE);
  1051.     if (slot->type)
  1052.         dump_expr(slot->type);
  1053.     else
  1054.         dump_op(fop_FALSE);
  1055.     dump_plist(slot->plist);
  1056.     }
  1057.  
  1058.     n = 0;
  1059.     for (initarg = c->initargs; initarg != NULL; initarg = initarg->next)
  1060.     n++;
  1061.     dump_integer(n);
  1062.     for (initarg = c->initargs; initarg != NULL; initarg = initarg->next) {
  1063.     dump_symbol(initarg->keyword);
  1064.     dump_plist(initarg->plist);
  1065.     }
  1066.  
  1067.     n = 0;
  1068.     for (inherited = c->inheriteds; inherited != NULL;
  1069.      inherited = inherited->next)
  1070.     n++;
  1071.     dump_integer(n);
  1072.     for (inherited = c->inheriteds; inherited != NULL;
  1073.      inherited = inherited->next) {
  1074.     dump_id(inherited->name);
  1075.     dump_plist(inherited->plist);
  1076.     }
  1077. }
  1078.  
  1079. static void dump_expr_constituent(struct expr_constituent *c)
  1080. {
  1081.     dump_op(fop_EXPR_CONSTITUENT);
  1082.     dump_expr(c->expr);
  1083. }
  1084.  
  1085. static void dump_local_constituent(struct local_constituent *c)
  1086. {
  1087.     struct method *m;
  1088.     int nlocals = 0;
  1089.  
  1090.     dump_op(fop_LOCAL_CONSTITUENT);
  1091.     for (m = c->methods; m != NULL; m = m->next_local)
  1092.     nlocals++;
  1093.     dump_integer(nlocals);
  1094.     for (m = c->methods; m != NULL; m = m->next_local)
  1095.     dump_method_parse(m);
  1096.     dump_body(c->body);
  1097. }
  1098.  
  1099. static void dump_handler_constituent(struct handler_constituent *c)
  1100. {
  1101.     dump_op(fop_HANDLER_CONSTITUENT);
  1102.     dump_body(c->body);
  1103. }
  1104.  
  1105. static void dump_let_constituent(struct let_constituent *let)
  1106. {
  1107.     dump_op(fop_LET_CONSTITUENT);
  1108.     dump_bindings(let->bindings);
  1109.     dump_body(let->body);
  1110. }
  1111.  
  1112. static void dump_tlf_constituent(struct tlf_constituent *c)
  1113. {
  1114.     lose("top-level-form method inserted when parsing only?");
  1115. }
  1116.  
  1117. static void dump_error_constituent(struct constituent *c)
  1118. {
  1119.     lose("Called dump on a parse tree with errors?");
  1120. }
  1121.  
  1122. static void dump_defmodule_constituent(struct defnamespace_constituent *c)
  1123. {
  1124.     dump_op(fop_DEFINE_MODULE);
  1125.     dump_defnamespace(c, TRUE);
  1126. }
  1127.  
  1128. static void dump_deflibrary_constituent(struct defnamespace_constituent *c)
  1129. {
  1130.     dump_op(fop_DEFINE_LIBRARY);
  1131.     dump_defnamespace(c, FALSE);
  1132. }
  1133.  
  1134.  
  1135. static void (*DumpConstituents[])() = {
  1136.     dump_defconst_constituent, dump_defvar_constituent,
  1137.     dump_defmethod_constituent, dump_defgeneric_constituent,
  1138.     dump_defclass_constituent, dump_expr_constituent,
  1139.     dump_local_constituent, dump_handler_constituent,
  1140.     dump_let_constituent, dump_tlf_constituent,
  1141.     dump_error_constituent, dump_defmodule_constituent,
  1142.     dump_deflibrary_constituent
  1143. };
  1144.  
  1145. static void dump_body(struct body *body)
  1146. {
  1147.     struct constituent *c;
  1148.     int nconstits = 0;
  1149.  
  1150.     for (c = body->head; c != NULL; c = c->next)
  1151.     nconstits++;
  1152.     dump_integer(nconstits);
  1153.     for (c = body->head; c != NULL; c = c->next)
  1154.     (*DumpConstituents[(int)c->kind])(c);
  1155. }
  1156.  
  1157. void dump_program(struct body *body)
  1158. {
  1159.     dump_body(body);
  1160. }
  1161.